Pascal Super Library/Pascal Super Library (CW International)(1997).bin/TSR/PPTSR10/FILER.PAS

Pascal/Delphi Source File | 1993-02-12 | 4KB | 181 lines

(*
Program  : filer.pas
Function : Example TSR program to view a file. Very basic viewing !!
Author   : P.Peters
Date     : June 1992
*)
{$m $1000,0,0}
{$r-,s-,x+}
program filer;
uses
 crt,tsrutil,tsr;
const
 idcode   = $c3;
 filename : string = '';

var
 fil      : text;
 scr      : array[1..4000] of byte;
 sat      : byte;

function fileexists( filename : string ) : boolean;
var
  f: file;
begin
  {$i-} assign( f,filename ); reset( f ); close( f ); {$i+}
  fileexists := (ioresult = 0) and (filename <> '');
end;

function waitkey : word;
begin
  write('Press any key to continue...');
  repeat until keyavail;
  waitkey := readkeycode;
  write(^m);
  clreol;
end;

procedure filit; far;
var s : string;
    i : word;
    k : word;
begin
  assign(fil,filename);
  {$i-}reset(fil);{$i+}
  if ioresult = 0 then begin
    i := 0;
    cursoroff;
    savescreen(1,1,80,25,scr);
    sat := textattr;
    textbackground(white);
    textcolor(black);
    clrscr;
    k := 0;
    while (lo(k) <> 27) and (not eof(fil)) do begin
      readln(fil,s);
      writeln(s);
      inc(i);
      if (i mod 24) = 0 then k := waitkey;
    end;
    if (i mod 24) <> 0 then waitkey;
    textattr := sat;
    restorescreen(1,1,80,25,scr);
    cursoron;
  end;
  {$i-}close(fil);{$i+}
end;

procedure receiver; far; assembler;
label
  tst3,fin;
asm
  cmp   ax,2                {set file name}
  jne   tst3
  mov   ds,bx
  mov   si,cx
  mov   ch,0
  mov   cl,ds:[si]
  inc   cx
  mov   bx,seg filename
  mov   es,bx
  mov   di,offset filename
  repnz movsb
  jmp   fin
tst3:
  cmp   ax,3  {get name}
  jne   fin
  mov   bx,seg filename
  mov   cx,offset filename
fin:
end;

procedure paramcheck; far;
var
  s : string;
  i : byte;

  procedure setfilename;
  begin
    filename := s;
    if tsrloaded then begin
      asm
        pusha
        mov  bx,seg filename
        mov  cx,offset filename
        mov  ax,idcode shl 8 + 2
        int  2fh
        popa
      end;
    end;
  end;

  procedure getinfo;
  begin
    if tsrloaded then begin
      asm
        pusha
        mov   ax,idcode shl 8 + 3
        int   2fh
        mov   ds,bx
        mov   si,cx
        mov   ch,0
        mov   cl,ds:[si]
        inc   cx
        mov   bx,seg filename
        mov   es,bx
        mov   di,offset filename
        repnz movsb
        popa
      end;
      writeln('Info from Tsr');
      writeln('  Filename : ',filename);
    end else begin
      writeln('Tsr receiver not installed.');
      halt;
    end;
  end;

  procedure writeopt;
  begin
    writeln('Usage:');
    writeln('  Filer [Option]');
    writeln('Options:');
    writeln('  /u     : Remove Tsr');
    writeln('  /i     : Display this info from Tsr');
    writeln('  <name> : file to display');
    halt;
  end;

begin
  if paramcount > 0 then
    for i := 1 to paramcount do begin
      s := paramstr(i);
      if s[1] = '/' then begin (* switch *)
        delete(s,1,1);
        s[1] := upcase(s[1]);
        case s[1] of
          'I' : getinfo;
          '?' : writeopt;
          else begin
            writeln('Invalid switch : ',s);
            writeopt;
          end;
        end;
      end else begin (* no switch *)
        if fileexists( s ) then
          setfilename
        else begin
          Writeln(^g'File not found : ',s );
          halt;
        end;
      end;
    end;
end;

begin
  if paramcount = 0 then
    writeln(^g'Parameter or switch required.')
  else
    tsrinstall('Alt-F',$2100,idcode,filit,receiver,paramcheck);
end.